unit uExpressionTree;

interface

type

  TExpressionType = (etNumber, etAddition, etSubtraction, etMultiplication,
    etDivision, etFactorial, etPower, etFunction, etPercentage, etNone);

  TExpressionTreeClass = class of TExpressionTree;

  TExpressionTree = class
  private
    FType: TExpressionType;
    FStringValue: string;
    FClass: TExpressionTreeClass;

    FLeftSubtree: TExpressionTree;
    FRightSubtree: TExpressionTree;

    procedure SkipParentheses(const AString: string; var index: Word);
    procedure ProcesLeftSubstring(const AString: string; index: Word);
    procedure ProcesRightSubstring(const AString: string; index: Word);
    procedure TrimStartingZero(var AString: string);

    function ParseAdditionOrSubtraction(const AString: string): Boolean;
    function ParseMultiplicationOrDivision(const AString: string): Boolean;
    function ParseFactorial(const AString: string): Boolean;
    function ParsePower(const AString: string): Boolean;
    function ParsePercentage(const AString: string): Boolean;
    function ParseFunction(const AString: string): Boolean;
    function ParseParentheses(const AString: string): Boolean;
    function ParseNumber(const AString: string): Boolean;

    function GetSubtreeString(ASubtree: TExpressionTree): string;

    function GetStringValue: string;
    function GetLeftSubtree: TExpressionTree;
    function GetRightSubtree: TExpressionTree;

  protected
    function GetOperationChar: Char;
    function GetOperationPriority: Byte;
    function IsAssociativeOperation: Boolean;

    property StringValue: string read GetStringValue;
    property LeftSubTree: TExpressionTree read GetLeftSubtree;
    property RightSubTree: TExpressionTree read GetRightSubtree;

  public
    constructor Create(AClass: TExpressionTreeClass);
    destructor Destroy; override;

    procedure Clear;
    procedure FromString(const AString: string);
    function ToString: string;

    property ExpressionType: TExpressionType read FType;
  end;

implementation

const

  OP_CHAR_ADDITION = '+';
  OP_CHAR_SUBTRACTION = '-';
  OP_CHAR_MULTIPLICATION = '*';
  OP_CHAR_DIVISION = '/';
  OP_CHAR_FACTORIAL = '!';
  OP_CHAR_POWER = '^';
  OP_CHAR_PERCENTAGE = '%';

{ TExpressionTreeNode }

procedure TExpressionTree.Clear;
begin
  FType := etNone;
  FStringValue := '';

  FLeftSubtree.Free;
  FLeftSubtree := nil;

  FRightSubtree.Free;
  FRightSubtree := nil;
end;

constructor TExpressionTree.Create(AClass: TExpressionTreeClass);
begin
  FType := etNone;
  FStringValue := '';
  FClass := AClass;

  FLeftSubtree := nil;
  FRightSubtree := nil;
end;

destructor TExpressionTree.Destroy;
begin
  FLeftSubtree.Free;
  FRightSubtree.Free;
  inherited;
end;

procedure TExpressionTree.FromString(const AString: string);
begin
  Clear;

  if AString = '' then
  begin
    ParseNumber('0');
    Exit;
  end;

  if ParseAdditionOrSubtraction(AString) then
    Exit;

  if ParseMultiplicationOrDivision(AString) then
    Exit;

  if ParsePower(AString) then
    Exit;

  if ParseFactorial(AString) then
    Exit;

  if ParsePercentage(AString) then
    Exit;

  if ParseFunction(AString) then
    Exit;

  if ParseParentheses(AString) then
    Exit;

  ParseNumber(AString);
end;

function TExpressionTree.GetLeftSubtree: TExpressionTree;
begin
  Result := FLeftSubtree;
end;

function TExpressionTree.GetOperationChar: Char;
begin
  case FType of
    etAddition:
      Result := OP_CHAR_ADDITION;

    etSubtraction:
      Result := OP_CHAR_SUBTRACTION;

    etMultiplication:
      Result := OP_CHAR_MULTIPLICATION;

    etDivision:
      Result := OP_CHAR_DIVISION;

    etFactorial:
      Result := OP_CHAR_FACTORIAL;

    etPower:
     Result := OP_CHAR_POWER;

    etPercentage:
     Result := OP_CHAR_PERCENTAGE;
  else
    Result := ' ';
  end;
end;

function TExpressionTree.GetOperationPriority: Byte;
begin
  case FType of
    etNumber, etFunction:
      Result := 1;

    etPercentage:
      Result := 2;

    etFactorial:
      Result := 3;

    etPower:
      Result := 4;

    etMultiplication, etDivision:
      Result := 5;

    etAddition, etSubtraction:
      Result := 6;
  else
    Result := 7;
  end;
end;

function TExpressionTree.GetRightSubtree: TExpressionTree;
begin
  Result := FRightSubtree;
end;

function TExpressionTree.GetStringValue: string;
begin
  Result := FStringValue;
end;

function TExpressionTree.GetSubtreeString(ASubtree: TExpressionTree): string;
var
  useParentheses: boolean;
begin
  if ASubtree = nil then
  begin
    Result := '';
    Exit;
  end;

  useParentheses := false;
  Result := ASubtree.ToString;

  if pos('-', Result) = 1 then
    useParentheses := true
  else if ASubtree.GetOperationPriority > Self.GetOperationPriority then
    useParentheses := true
  else if ASubtree.GetOperationPriority = Self.GetOperationPriority then
  begin
    if (not ASubtree.IsAssociativeOperation) or (not Self.IsAssociativeOperation) then
      useParentheses := true;
  end;

  if useParentheses then
    Result := '(' + Result + ')';
end;

function TExpressionTree.IsAssociativeOperation: Boolean;
begin
  case Self.FType of
    etAddition,
    etMultiplication:
      Result := true;
  else
    Result := false;
  end;
end;

function TExpressionTree.ParseAdditionOrSubtraction(const AString: string): Boolean;
var
  i: Word;
begin
  Result := false;

  i := length(AString);
  SkipParentheses(AString, i);
  while i > 0 do
  begin
    if AString[i] in [OP_CHAR_ADDITION, OP_CHAR_SUBTRACTION] then
    begin
      if AString[i] = OP_CHAR_ADDITION then
        FType := etAddition
      else
        FType := etSubtraction;

      ProcesLeftSubstring(AString, i);
      ProcesRightSubstring(AString, i);

      Result := true;
      break;
    end;
    Dec(i);
    SkipParentheses(AString, i);
  end;
end;

function TExpressionTree.ParseFactorial(const AString: string): Boolean;
var
  i: Word;
begin
  Result := false;

  i := length(AString);
  SkipParentheses(AString, i);
  while i > 1 do
  begin
    if AString[i] = OP_CHAR_FACTORIAL then
    begin
      FType := etFactorial;
      ProcesLeftSubstring(AString, i);
      Result := true;
      break;
    end;
    Dec(i);
    SkipParentheses(AString, i);
  end;
end;

function TExpressionTree.ParseFunction(const AString: string): Boolean;
var
  i: Word;
begin
  Result := false;

  i := length(AString);
  SkipParentheses(AString, i);
  if (i > 0) and (pos('(', AString) <> 0) then
  begin
    FType := etFunction;
    FStringValue := copy(AString, 1, i);
    ProcesRightSubstring(AString, i);
    Result := true;
  end;
end;

function TExpressionTree.ParseMultiplicationOrDivision(const AString: string): Boolean;
var
  i: Word;
begin
  Result := false;

  i := length(AString);
  SkipParentheses(AString, i);
  while i > 1 do
  begin
    if AString[i] in [OP_CHAR_MULTIPLICATION, OP_CHAR_DIVISION] then
    begin
      if AString[i] = OP_CHAR_MULTIPLICATION then
        FType := etMultiplication
      else
        FType := etDivision;

      ProcesLeftSubstring(AString, i);
      ProcesRightSubstring(AString, i);

      Result := true;
      break;
    end;
    Dec(i);
    SkipParentheses(AString, i);
  end;
end;

function TExpressionTree.ParseNumber(const AString: string): Boolean;
begin
  FType := etNumber;
  FStringValue := AString;
  if FStringValue[1] = '+' then
    system.Delete(FStringValue, 1, 1);
  Result := true;
end;

function TExpressionTree.ParseParentheses(const AString: string): Boolean;
var
  substring: string;
begin
  Result := false;

  if AString[1] = '(' then
  begin
    substring := copy(AString, 2, length(AString) - 2);
    self.FromString(substring);
    Result := true;
  end;
end;

function TExpressionTree.ParsePercentage(const AString: string): Boolean;
var
  i: Word;
begin
  Result := false;

  i := length(AString);
  SkipParentheses(AString, i);
  while i > 1 do
  begin
    if AString[i] = OP_CHAR_PERCENTAGE then
    begin
      FType := etPercentage;
      ProcesLeftSubstring(AString, i);
      Result := true;
      break;
    end;
    Dec(i);
    SkipParentheses(AString, i);
  end;
end;

function TExpressionTree.ParsePower(const AString: string): Boolean;
var
  i: Word;
begin
  Result := false;

  i := 1;
  SkipParentheses(AString, i);
  while i < length(AString) do
  begin
    if AString[i] = OP_CHAR_POWER then
    begin
      FType := etPower;

      ProcesLeftSubstring(AString, i);
      ProcesRightSubstring(AString, i);

      Result := true;
      break;
    end;
    Inc(i);
    SkipParentheses(AString, i);
  end;
end;


procedure TExpressionTree.SkipParentheses(const AString: string; var index: Word);
var
  nestingLevel: Byte;
begin
  if index = 0 then
    Exit;

  nestingLevel := 0;
  if AString[index] = ')' then
  begin
    while index > 0 do
    begin
      if AString[index] = ')' then
        Inc(nestingLevel);
      if AString[index] = '(' then
        Dec(nestingLevel);

      Dec(index);

      if nestingLevel = 0 then
        break;
    end;
  end
  else if AString[index] = '(' then
  begin
    while index > 0 do
    begin
      if AString[index] = '(' then
        Inc(nestingLevel);
      if AString[index] = ')' then
        Dec(nestingLevel);

      Inc(index);

      if nestingLevel = 0 then
        break;
    end;
  end;
end;

procedure TExpressionTree.ProcesLeftSubstring(const AString: string; index: Word);
var
  substring: string;
begin
  substring := copy(AString, 1, index - 1);
  FLeftSubtree := FClass.Create(FClass);
  FLeftSubtree.FromString(substring);
end;

procedure TExpressionTree.ProcesRightSubstring(const AString: string; index: Word);
var
  substring: string;
begin
  substring := copy(AString, index + 1, length(AString) - index);
  FRightSubtree := FClass.Create(FClass);
  FRightSubtree.FromString(substring);
end;

function TExpressionTree.ToString: string;
begin
  case FType of
    etNumber:
      Result := FStringValue;

    etAddition,
    etSubtraction,
    etMultiplication,
    etDivision,
    etPower:
      Result := GetSubtreeString(FLeftSubtree) + GetOperationChar + GetSubtreeString(FRightSubtree);

    etFactorial,
    etPercentage:
      Result := GetSubtreeString(FLeftSubtree) + GetOperationChar;

    etFunction:
      Result := FStringValue + '(' + FRightSubtree.ToString + ')';
  else
    Result := '';
  end;

  TrimStartingZero(Result);
end;

procedure TExpressionTree.TrimStartingZero(var AString: string);
begin
  if pos('0-', AString) = 1 then
    Delete(AString, 1, 1)
  else if pos('0+', AString) = 1 then
    Delete(AString, 1, 2);
end;

end.
